home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATH_LIB / HYPERBOL.PAS next >
Pascal/Delphi Source File  |  1995-05-23  |  3KB  |  121 lines
  1. Unit HYPERBOL;
  2.  
  3. (* Bibliotheque mathematique des fonctions hyperboliques *)
  4. (* JD GAYRARD mars 94 *)
  5.  
  6. interface
  7.  
  8. uses MATHLIB;
  9.  
  10. const TANH_MAX = 13;       (* argument maximum de th(x) *)
  11.       SQR_MAX = 1.3E+19;   (* argument maximum d'un carre *)
  12.       EXP_MAX = 88.0288;   (* argument maximum de exp *)
  13.  
  14. (* fonctions trigonometriques directes *)
  15. function ch(x : real): real;
  16. function sh(x : real): real;
  17. function th(x : real): real;
  18.  
  19. (* fonctions trigonometriques inverses *)
  20. function arg_ch(x : real): real;
  21. function arg_sh(x : real): real;
  22. function arg_th(x : real): real;
  23.  
  24. implementation
  25.  
  26. (* fonctions trigonometriques directes *)
  27.  
  28. function ch(x : real): real;
  29. (* retourne le cosinus hyperbolique de l'argument *)
  30. (* ch(x) = [exp(x) + exp(-x)] / 2 *)
  31. begin
  32. if (x > EXP_MAX) or (x < - EXP_MAX)
  33.    then begin
  34.         writeln('******** Fonction ch ********');
  35.         writeln('********* OVERFLOW **********');
  36.         halt
  37.         end
  38.    else begin
  39.         x := exp(x);
  40.         ch := 0.5 * (x + 1.0 / x)
  41.         end
  42. end;
  43.  
  44. function sh(x : real): real;
  45. (* retourne le sinus hyperbolique de l'argument *)
  46. (* sh(x) = [exp(x) - exp(-x)] / 2 *)
  47. begin
  48. if (x > EXP_MAX) or (x < -EXP_MAX)
  49.    then begin
  50.         writeln('******** Fonction sh ********');
  51.         writeln('********* UNDERFLOW *********');
  52.         halt
  53.         end
  54.    else begin
  55.         x := exp(x);
  56.         sh := 0.5 * (x - (1.0 / x))
  57.         end
  58. end;
  59.  
  60. function th(x : real): real;
  61. (* retourne la tangente hyperbolique de l'argument *)
  62. (* th(x) = sh(x) / ch(x) *)
  63. (* th(x) = [exp(x) - exp(x)] / [exp(x) + exp(-x)] *)
  64. begin
  65. if (x > TANH_MAX) or (x < - TANH_MAX)
  66.    then if x > 0.0 then th := 1.0
  67.                    else th := - 1.0
  68.    else th := sh(x) / ch(x)
  69. end;
  70.  
  71. (* fonctions trigonometriques inverses *)
  72.  
  73. function arg_ch(x : real): real;
  74. (* retourne l'arc cosinus hyperbolique de l'argument *)
  75. (*                       ________          *)
  76. (* arg ch(x) = ln ( x + V x.x - 1 )  x >=1 *)
  77. begin
  78. if x < 1.0
  79.    then begin
  80.         writeln('******** Fonction arg_ch ********');
  81.         writeln('********** RANGE ERROR **********');
  82.         halt
  83.         end
  84.    else if x > SQR_MAX
  85.            then begin
  86.                 writeln('******** Fonction  arg_ch ********');
  87.                 writeln('************ OVERFLOW ************');
  88.                 halt
  89.                 end
  90.            else arg_ch := ln(x + sqrt(x * x - 1.0))
  91. end;
  92.  
  93. function arg_sh(x : real): real;
  94. (* retourne l'arc sinus hyperbolique de l'argument *)
  95. (*                       _________   *)
  96. (* arg sh(x) = ln ( x + V x.x + 1 )  *)
  97. begin
  98. if (x < -SQR_MAX) or (x > SQR_MAX)
  99.    then begin
  100.         writeln('******** Fonction Arg_sh ********');
  101.         writeln('************ OVERFLOW ***********');
  102.         halt
  103.         end
  104.    else arg_sh := ln(x + sqrt(x * x + 1.0))
  105. end;
  106.  
  107. function arg_th(x : real): real;
  108. (* retourne l'arc tangente hyperbolique de l'argument *)
  109. (* arg th(x) = 1/2 ln [ (1 + x) / (1 - x) *)
  110. begin
  111. if (x <= -1.0) or (x >= 1.0)
  112.    then begin
  113.         writeln('******** Fonction Arg_th ********');
  114.         writeln('********** RANGE ERROR **********');
  115.         halt
  116.         end
  117.    else arg_th := 0.5 * ln((1.0 + x) / (1.0 - x))
  118. end;
  119.  
  120.  
  121. end.